Attribute VB_Name = "modCDECLFunctionDelegator"
'***************************************************************
' (c) Copyright 2000 Matthew J. Curland
'
' This file is from the CD-ROM accompanying the book:
' Advanced Visual Basic 6: Power Techniques for Everyday Programs
'   Author: Matthew Curland
'   Published by: Addison-Wesley, July 2000
'   ISBN: 0-201-70712-8
'   http://www.PowerVB.com
'
' You are entitled to license free distribution of any application
'   that uses this file if you own a copy of the book, or if you
'   have obtained the file from a source approved by the author. You
'   may redistribute this file only with express written permission
'   of the author.
'
' This file depends on:
'   References:
'     VBoostTypes6.olb (VBoost Object Types (6.0))
'   Files:
'     None
'   Minimal VBoost conditionals:
'     None
'   Conditional Compilation Values:
'     CDECLFUNCTIONDELEGATOR_NOSTACK = 1 'eliminates support for NewCDECLDelegator
'     CDECLFUNCTIONDELEGATOR_NOHEAP = 1  'eliminates support for InitCDECLDelegator
'
' This file is discussed in Chapter 11.
'***************************************************************
Option Explicit

'Test for InitCDECLDelegator support
#Const STACKALLOCSUPPORT = CDECLFUNCTIONDELEGATOR_NOSTACK = 0

'Test for NewCDECLDelegator support
#Const HEAPALLOCSUPPORT = CDECLFUNCTIONDELEGATOR_NOHEAP = 0

'Test for InitCDECLThunk support
#Const THUNKSUPPORT = CDECLFUNCTIONDELEGATOR_NOTHUNK = 0

Private Const cCDECLDelegateSize As Long = 22

#If THUNKSUPPORT Then
Private Const cCDECLThunkSize As Long = 19
Private Type CDECLThunkBytes
    Bytes(cCDECLThunkSize - 1) As Long
End Type

Public Type CDECLThunk
    pfn As Long
    Code As CDECLThunkBytes
End Type
Private m_CDECLThunkASM As CDECLThunkBytes       'Thunk bits to make stdcall look like cdecl call
#End If 'THUNKSUPPORT

#If STACKALLOCSUPPORT Or HEAPALLOCSUPPORT Then
Private m_CDECLDelegateASM As CDECLDelegateBytes 'Buffer for ASM code (vtable call to cdecl call)

Private Type CDECLDelegateBytes
    Bytes(cCDECLDelegateSize - 1) As Long
End Type

Private Type DelegatorVTables
    VTable(7) As Long  'QIOK vtable in 0 to 3, QIFail vtable in 4 to 7
End Type

#If STACKALLOCSUPPORT Then
'Structure for a stack allocated Delegator
Private m_VTables As DelegatorVTables
Private m_pVTableOKQI As Long       'Pointer to vtable, no allocation version
Private m_pVTableFailQI As Long     'Pointer to vtable, no allocation version
Public Type CDECLFunctionDelegator
    pVTable As Long   'This has to stay at offset 0
    pfn As Long       'This has to stay at offset 4
    StackSize As Long 'This has to stay at offset 8
End Type
#End If 'STACKALLOCSUPPORT

#If HEAPALLOCSUPPORT Then
'Structure for a heap allocated Delegator
Private m_VTablesHeapAlloc As DelegatorVTables
Private m_pVTableHeapAllocOKQI As Long   'Pointer to vtable, heap version
Private m_pVTableHeapAllocFailQI As Long 'Pointer to vtable, heap version
Private Type CDECLFunctionDelegatorHeapAlloc
    pVTable As Long   'This has to stay at offset 0
    pfn As Long       'This has to stay at offset 4
    StackSize As Long 'This has to stay at offset 8
    cRefs As Long
End Type
#End If 'HEAPALLOCSUPPORT

#If STACKALLOCSUPPORT Then
'Functions to initialize a Delegator object on an existing CDECLFunctionDelegator
Public Function InitCDECLDelegator(Delegator As CDECLFunctionDelegator, Optional ByVal pfn As Long, Optional ByVal StackSize As Long) As IUnknown
    If m_pVTableOKQI = 0 Then InitVTables
    With Delegator
        .pVTable = m_pVTableOKQI
        .pfn = pfn
        .StackSize = StackSize
    End With
    CopyMemory InitCDECLDelegator, VarPtr(Delegator), 4
End Function
Private Sub InitVTables()
Dim pAddRefRelease As Long
    With m_VTables
        .VTable(0) = FuncAddr(AddressOf QueryInterfaceOK)
        .VTable(4) = FuncAddr(AddressOf QueryInterfaceFail)
        pAddRefRelease = FuncAddr(AddressOf AddRefRelease)
        .VTable(1) = pAddRefRelease
        .VTable(5) = pAddRefRelease
        .VTable(2) = pAddRefRelease
        .VTable(6) = pAddRefRelease
        If m_CDECLDelegateASM.Bytes(0) = 0 Then InitCDECLDelegateASM
        .VTable(3) = VarPtr(m_CDECLDelegateASM.Bytes(0))
        .VTable(7) = .VTable(3)
        m_pVTableOKQI = VarPtr(.VTable(0))
        m_pVTableFailQI = VarPtr(.VTable(4))
    End With
End Sub
Private Function QueryInterfaceOK(This As CDECLFunctionDelegator, riid As Long, pvObj As Long) As Long
    pvObj = VarPtr(This)
    This.pVTable = m_pVTableFailQI
End Function
Private Function AddRefRelease(ByVal This As Long) As Long
    'Nothing to do, memory not refcounted
End Function
#End If 'STACKALLOCSUPPORT

#If HEAPALLOCSUPPORT Then
'Functions to create a refcounted version of the function pointer wrapper object
Public Function NewCDECLDelegator(ByVal pfn As Long, ByVal StackSize As Long) As IUnknown
Dim Struct As CDECLFunctionDelegatorHeapAlloc
Dim ThisPtr As Long
    If m_pVTableHeapAllocOKQI = 0 Then InitHeapAllocVTables
    With Struct
        ThisPtr = CoTaskMemAlloc(LenB(Struct))
        If ThisPtr = 0 Then Err.Raise 7
        .pVTable = m_pVTableHeapAllocOKQI
        .cRefs = 1
        .pfn = pfn
        .StackSize = StackSize
        CopyMemory ByVal ThisPtr, Struct, LenB(Struct)
        CopyMemory NewCDECLDelegator, ThisPtr, 4
    End With
End Function
Private Sub InitHeapAllocVTables()
    With m_VTablesHeapAlloc
        .VTable(0) = FuncAddr(AddressOf QueryInterfaceHeapAllocOK)
        .VTable(4) = FuncAddr(AddressOf QueryInterfaceFail)
        .VTable(1) = FuncAddr(AddressOf AddRefHeapAlloc)
        .VTable(5) = .VTable(1)
        .VTable(2) = FuncAddr(AddressOf ReleaseHeapAlloc)
        .VTable(6) = .VTable(2)
        If m_CDECLDelegateASM.Bytes(0) = 0 Then InitCDECLDelegateASM
        .VTable(3) = VarPtr(m_CDECLDelegateASM.Bytes(0))
        .VTable(7) = .VTable(3)
        m_pVTableHeapAllocOKQI = VarPtr(.VTable(0))
        m_pVTableHeapAllocFailQI = VarPtr(.VTable(4))
    End With
End Sub
Private Function QueryInterfaceHeapAllocOK(This As CDECLFunctionDelegatorHeapAlloc, riid As Long, pvObj As Long) As Long
    With This
        pvObj = VarPtr(.pVTable)
        .cRefs = .cRefs + 1
        .pVTable = m_pVTableHeapAllocFailQI
    End With
End Function
Private Function AddRefHeapAlloc(This As CDECLFunctionDelegatorHeapAlloc) As Long
    With This
        .cRefs = .cRefs + 1
        AddRefHeapAlloc = .cRefs
    End With
End Function
Private Function ReleaseHeapAlloc(This As CDECLFunctionDelegatorHeapAlloc) As Long
    With This
        .cRefs = .cRefs - 1
        ReleaseHeapAlloc = .cRefs
        If .cRefs = 0 Then
            'Don't try to step over FreeBuffer, we're freeing
            'This, and the debugger could die.
            CoTaskMemFree VarPtr(.pVTable)
        End If
    End With
End Function
#End If 'HEAPALLOCSUPPORT

Private Function QueryInterfaceFail(ByVal This As Long, riid As Long, pvObj As Long) As Long
    pvObj = 0
    QueryInterfaceFail = E_NOINTERFACE
End Function

Private Function FuncAddr(ByVal pfn As Long) As Long
    FuncAddr = pfn
End Function

Private Sub InitCDECLDelegateASM()
'Here's the assembly code to translate a stdcall vtable call into
'a cdecl non-vtable call.  This code requires the stack size to be known.
'The whole point of this is to make a cdecl call, then clean the stack after
'the call so that it looks like a stdcall.  In order to do this, we need to
'store our data on the stack and then call the cdecl function.  This requires
'that we duplicate the parameters for the call above our stack data and push
'our own base pointer as a reference.  After the function returns, we use the
'base pointer to relocate our own values and remove the correct number of bytes
'from the stack.

'#define _PAGESIZE_ 0x1000
'push ebp                       // Run some prolog code
'mov ebp, esp                   // this = [ebp + 8], return = [ebp + 4], old ebp = [ebp]
'push esi
'push edi
'push ebx
'mov eax, [ebp + 8]             // Get this pointer
'mov ecx, [eax + 8]             // Get byte count into ecx
'mov ebx, ecx                   // Save the stacksize in ebx
'
'mov edi, esp                   // Make sure we have the stack safely loaded
'
'probepages:
'cmp ecx, _PAGESIZE_            // See if we need more than one page of stack
'jb short lastpage              // Note that this is very unlikely, but we must be safe.
'
'sub ecx, _PAGESIZE_            // yes, move down a page
'sub edi, _PAGESIZE_            // adjust request and...
'
'test DWORD PTR [edi], ecx      // ...probe it
'
'jmp short probepages           // Keep going
'
'lastpage:
'sub edi, ecx                   // Do a final probe
'test DWORD PTR [edi], ecx
'
'mov ecx, ebx                   // Reload ecx in case probing changed it
'
'mov esi, ebp                   // Establish the source pointer for the stack copy
'Add esi, 12
'
'mov esp, edi                   // Move the stack down before we lose edi
'
'shr ecx, 2                     // Change the byte stack size in ecx to a DWORD count
'cld                            // Copy ascending
'rep movsd                      // Do the stack copy (the DWORD count is in ecx)
'
'call DWORD PTR [eax + 4]       // Make the cdecl function call (the this pointer is still in eax)
'
'mov ecx, ebp                   // Move the return value to the correct position on the stack
'add ecx, 8                     // Add to move past this and function return values
'add ecx, ebx                   // Add extra stack size
'mov esi, [ebp + 4]             // Get return address.  Use esi since eax/edx hold the return value.
'mov [ecx], esi                 // Assign return address to correct position on stack.
'
'mov esp, ebp                   // Move the stack and restore the saved registers
'sub esp, 12
'pop ebx
'pop edi
'pop esi
'pop ebp
'mov esp, ecx                   // Move the stack pointer down
'ret                            // return to the calling function

    With m_CDECLDelegateASM
        .Bytes(0) = &H56EC8B55
        .Bytes(1) = &H458B5357
        .Bytes(2) = &H8488B08
        .Bytes(3) = &HFC8BD98B
        .Bytes(4) = &H1000F981
        .Bytes(5) = &H10720000
        .Bytes(6) = &H1000E981
        .Bytes(7) = &HEF810000
        .Bytes(8) = &H1000
        .Bytes(9) = &HE8EB0F85
        .Bytes(10) = &HF85F92B
        .Bytes(11) = &HF58BCB8B
        .Bytes(12) = &H8B0CC683
        .Bytes(13) = &H2E9C1E7
        .Bytes(14) = &HFFA5F3FC
        .Bytes(15) = &HCD8B0450
        .Bytes(16) = &H308C183
        .Bytes(17) = &H4758BCB
        .Bytes(18) = &HE58B3189
        .Bytes(19) = &H5B0CEC83
        .Bytes(20) = &H8B5D5E5F
        .Bytes(21) = &HCCCCC3E1
    End With
End Sub
#End If 'HEAPALLOCSUPPORT Or STACKALLOCSUPPORT

#If THUNKSUPPORT Then
Public Sub InitCDECLThunk(CDECLThunk As CDECLThunk, ByVal pfn As Long, ByVal StackSize As Long)
    If m_CDECLThunkASM.Bytes(0) = 0 Then InitCDECLThunkASM
    With CDECLThunk.Code
        CopyMemory .Bytes(0), m_CDECLThunkASM.Bytes(0), 4 * cCDECLThunkSize
        .Bytes(1) = StackSize
        .Bytes(16) = pfn
        'Inlined UnsignedAdd
        CDECLThunk.pfn = (VarPtr(.Bytes(0)) Xor &H80000000) + 3 Xor &H80000000
    End With
End Sub

Public Sub UpdateCDECLThunk(CDECLThunk As CDECLThunk, ByVal pfn As Long, ByVal StackSize As Long)
    With CDECLThunk.Code
        .Bytes(1) = StackSize
        .Bytes(16) = pfn
    End With
End Sub

Private Sub InitCDECLThunkASM()
'Here's the assembly code to make a caller expecting a cdecl function
'actually call a stdcall function.  The principle is simple: since the
'caller leaves the parameters on the stack, we'll just duplicate the
'parameters so that when the stdcall function cleans the stack, it is still
'left with the right number of parameters for the caller to clean.  This
'asm isn't quite complete in that the stacksize value and stdcall function
'pointer values need to be inserted into the correct locations.

'#define _PAGESIZE_ 0x1000
'nop                            // 3 nops so our insertion values end up dword aligned
'nop
'nop
'mov ecx, 16                    // 16 is a sample value (replace with real number)
'mov edx, ecx                   // Store current ecx value in edx in case ecx changes during the probing code
'add ecx, 8                     // Adjust for esi, edi push
'mov eax, esp                   // Grab the current stack pointer
'
'probepages:
'cmp ecx, _PAGESIZE_            // See if we've requested more than one page of stack
'jb short lastpage              // Note that this is very unlikely, but we must be safe.
'
'sub     ecx, _PAGESIZE_        // yes, move down a page
'sub     eax, _PAGESIZE_        // adjust request and...
'
'test    DWORD PTR [eax],ecx    // ...probe it
'
'jmp short probepages           // Keep going
'
'lastpage:
'sub eax, ecx                   // This is where we want the stack to be when we're done
'test DWORD PTR [eax], ecx      // Probe this position on the stack to make sure its loaded
'
'mov [eax], edi                 // Save off the current edi and esi registers
'mov [eax + 4], esi
'
'mov edi, eax                   // Get ready to do the copy.  Set the dest to the adjusted location.
'Add edi, 8
'mov esi, esp                   // Set the source to esp, which is the return address
'mov ecx, edx                   // Restore ecx value from edx
'shr ecx, 2                     // Change from a byte count to a DWORD count
'inc ecx                        // Add 1 DWORD for the return address
'cld                            // Set the ascending flag
'rep movsd                      // Do the stack copy.  The last dest is the starting source.
'
'mov edx, 1234h                 // Get the function pointer (replace when thunk runs)
'mov esp, eax                   // Move the stack up to the new location
'
'pop edi                        // Restore registers
'pop esi
'jmp edx                        // Jump to the stdcall function
    
    With m_CDECLThunkASM
        'pfn should be set to VarPtr(Item(0) + 3)
        .Bytes(0) = &HB9909090
        '.Bytes(1) = 0 'Insert stacksize here
        .Bytes(2) = &HC183D18B
        .Bytes(3) = &H81C48B08
        .Bytes(4) = &H1000F9
        .Bytes(5) = &H810F7200
        .Bytes(6) = &H1000E9
        .Bytes(7) = &H10002D00
        .Bytes(8) = &H8850000
        .Bytes(9) = &HC12BE9EB
        .Bytes(10) = &H38890885
        .Bytes(11) = &H8B047089
        .Bytes(12) = &H8C783F8
        .Bytes(13) = &HCA8BF48B
        .Bytes(14) = &H4102E9C1
        .Bytes(15) = &HBAA5F3FC
        '.Bytes(16) = 0 'Insert function pointer here
        .Bytes(17) = &H5E5FE08B
        .Bytes(18) = &HCCCCE2FF
    End With
End Sub
#End If 'THUNKSUPPORT
